COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C******* DREDIT,STPT,GTPT,EDTYP,ITYP,FILLQ,UNPACK,REPACK, READ,NUMZ,LO2UP
C00009 00003		SUBROUTINE LO2UP(J)
C00012 ENDMK
C⊗;
C******* DREDIT,STPT,GTPT,EDTYP,ITYP,FILLQ,UNPACK,REPACK, READ,NUMZ,LO2UP
	SUBROUTINE DREDIT
	COMMON  /ED/K,NEXT,NN,NX,NY,J
	COMMON /RZ/RSZ,RJB,CENTR  /RC/MCLEF(1)
	COMMON/ZN/SCLEF(2,400),N  /LL/LL  /JJJ/JJJ
	EQUIVALENCE(M,SCLEF(2,1)),(KK,SCLEF(1,1))
	NEXTX=NEXT-1
	J=MCLEF(1)
20	IF(K.EQ.'D')GO TO 1
C  MOVE CURSOR TO INSERT POINT, TYPE CR.
9	FORMAT(' SET POINT ',$)
	IF(JJJ.EQ.-2)GO TO 131
C  FOR CONTINUING RELATIVE CHANGE
5	TYPE 9
	ACCEPT 3,L

	IF(L.EQ.'B'.OR.L.EQ.'N')RETURN
C N OR B=BACKUP, J=INSERT OR ALTER TO JUMP, C=ALTER JUMP TO CONT.
	IF(L.EQ.' ')GO TO 12
	IF(L.NE.'F')GO TO 50
	MCLEF(NEXT-1)=MCLEF(NEXT-1)+200000000
	RETURN
C ABOVE SET NEW FILL POINT.
50	REREAD 33,ML,MLA
	IF(JJJ)JJJ=-2
C TO SET POINT BY NUM(NOT FOR FILLER)	NOT NOW IN!
131	IF(M.GE.0)CALL UNPACK(NX,NY,LL,MCLEF(NEXTX))
C  FOR RELATIVE POS. CHANGE
	X=NX+ML
	Y=NY+MLA
	GO TO 13
CIRC12	CONTINUE
12	CALL RDCUR(NX,NY)
130	X=STPT(FLOAT(NX),RJB)
	Y=STPT(FLOAT(NY),CENTR)
13	NX=GTPT(X,RJB)
	NY=GTPT(Y,CENTR)
	IF(K.EQ.0)GO TO 14
CIRC	CALL CURSOR(NX,NY)
	CALL SETCUR(NX,NY,0)
	NT=NEXT
	L=NT
40	FORMAT(' POINT OK? (Y,N,B,J,F OR C) ',$)
C Y=YES,N=NO,B=BACKUP,J=JUMP,F=START FILL,C=CONTINUE(NULLIFY JUMP)
	TYPE 4,L,X,Y
	TYPE 40
	CALL A5IN(L)
	IF(L.EQ.'B')RETURN
	IF(L.EQ.'N')GO TO 5
	IF(K.NE.'A')GO TO 8
C  WHAT IS ABOVE FOR?????
	NT=NEXTX
	GO TO 7
11	FORMAT(I3,')',2I6,1X$)
8	A=X
	B=Y
	K=0
	GO TO 12
C NOW ASSUMES → IF NO ← POINT FOUND
14	IF(NX.EQ.SCLEF(1,NT-2).AND.NY.EQ.SCLEF(2,NT-2))NT=NT-1
15	X=A
	Y=B
	J=J+1
	DO 6 L=J,NT+1,-1
6	MCLEF(L)=MCLEF(L-1)
7	LL=0
	NX=X
	NY=Y
	IF(MCLEF(NT).GT.100000000.AND.L.NE.'C')LL=(MCLEF(NT)/100000000)*
	1 100000000
	IF(L.EQ.'J')LL=100000000
	IF(L.EQ.'F')LL=200000000
	K=MCLEF(NT)
	CALL REPACK(NX,NY,LL,MCLEF(NT))
	GO TO 100
3	FORMAT(A1)
33	FORMAT(2I)
4	FORMAT(I4,')',2F6.0)
C  NT IS FOR INSERTS
1	IF(J-NEXT)RETURN
	DO 10 L=NEXT,J+1
	IF(L.EQ.'F')LL=200000000
10	MCLEF(L-1)=MCLEF(L)
	J=J-1
100	MCLEF(1)=J
	KK=0
	IF(MCLEF(2).LT.100000000)MCLEF(2)=MCLEF(2)+100000000
CIRC	CALL DPYCLR
	CALL HYDPOG(1)
	KK=1
	KNT=0
CIRC	CALL RDRAW(2,MCLEF(1),MCLEF)
	CALL RDRAW(1,2,MCLEF(1),MCLEF)
	END

C*******************************************************
	FUNCTION STPT(A,X)
	COMMON /RZ/RSZ,RJB,CENTR
	R=.5
	Q=A/RSZ-X
	IF(Q.LT.0)R=-R
	STPT=IFIX(Q+R)
	RETURN
	END

	FUNCTION GTPT(A,X)
	COMMON /RZ/RSZ,RJB,CENTR
	GTPT=(A+X)*RSZ
	END



	SUBROUTINE SMOOTH(JQ)
	COMMON/ED/KX,NEXT,NN,NX,NY,J/LL/L
CIRC	COMMON /DPY/NDP,IOV
	COMMON /RC/MCLEF(1)
	COMMON /RZ/RSZ,RJB,CENTR
	COMMON /FL/IC,NJ,NQ,RZ
	DIMENSION BUF2(700),SX(512),SY(512)
	COMMON/NFF/NE(513)
	DATA INC/10/
	RR=RSZ
	COMMON X(100),Y(100),N,X1(512),Y1(512),S(100),K
CIRC	IF(JQ.EQ.0)CALL DPYCLR
	JL=0
	NOFIL=-1
	IF(JQ.EQ.0)NOFIL=0
100	JY=2
CIRC	CALL DPYCLR
	CALL HYDPOG(1)
	CALL DPYSET(3,BUF2,700)
	J=MCLEF(1)
7	JX=J
8	KX=0
	DO 1 K=JY,J
	CALL UNPACK(JA,JB,L,MCLEF(K))
	IF(L.GE.100000000.AND.K.GT.JY)GO TO 6
C  JUMP WHEN INVIS. VECT.
	KX=KX+1
	X(KX)=JA+RJB
1	Y(KX)=JB+CENTR
9	X(KX+1)=999.
4	N=KX
	CALL SS
	JL=JL+1
	JK=JL
	SX(JL)=X1(1)*RR
	SY(JL)=Y1(1)*RR
	CALL LINES(X1(1),Y1(1),3)
	DO 5 K=2,512,INC
	JL=JL+1
	SX(JL)=X1(K)*RR
	SY(JL)=Y1(K)*RR
	NE(JL)=0
5	CALL LINES(X1(K),Y1(K),2)
	IF(SX(JL).NE.SX(JK))SX(JK)=SX(JL)
	IF(SY(JL).NE.SY(JK))SY(JK)=SY(JL)
	NE(JK)=3
C FOR INVIS. VECTOR
CIRC	CALL DPYOUT(NDP)
	CALL DPYOUT(3)
	CALL POG1
10	IF(JX.NE.J)GO TO 7
	IF(NOFIL)RETURN
200	NE(1)=JL
	CALL FILLQ(SX,SY,NE)
	RETURN
6	JY=K
	JX=JY
	GO TO 9
	END

	SUBROUTINE EDTYP(K,X,Y,JJJ)
7	TYPE 57
	READ(5,1,ERR=3)K,X,Y
1	FORMAT(A1,2F)
	GO TO 10
3	READ(5,4,ERR=5)K,X,Y
	GO TO 10
4	FORMAT(A2,2F)
5	READ(5,6,ERR=8)K,X,Y
	GO TO 10
8	READ(5,1)K
	GO TO 7
6	FORMAT(A3,2F)
10	CALL LO2UP(K)
	IF(K.NE.' ')JJJ=0
57	FORMAT(' TYPE D, A, I OR X ',$)
C  M  N1, N2  =  MOVE SEGS N1 THROUGH N2.
	END

	SUBROUTINE ITYP
	COMMON /RZ/RSZ,RJB,CENTR
	COMMON/ED/K,NEXT,NN,NX,NY,J
	A=STPT(FLOAT(NX),RJB)
	B=STPT(FLOAT(NY),CENTR)
	TYPE 1,NN,A,B
1	FORMAT(I4,')',2F6.0)
	END

	SUBROUTINE FILLQ(Q,R,N)
	DIMENSION Q(1),R(1),N(1)
	COMMON /RZ/RSZ,RJB,CENTR
	DATA M/6/
C  M=FILLER INCREMENT
1	RZ=RSZ
	RSZ=1.0
	CALL FILLER(Q,R,N,M)
	RSZ=RZ
	CALL DPYOUT(1)
	END

	SUBROUTINE LO2UP(J)
C CONVERTS ALL LOWER CASE IN WORD J TO UPPER CASE.
	J=J.AND..NOT.((J/2).AND."201004020100)
	END

	SUBROUTINE RREAD(I,V)
C TAKES ASCII INPUT (INP) STRING, SEPARATES LETTERS FROM NUMBERS.
C MAKES ALL NUMBS FLTING PT.  FILLS UP END OF ARRAY WITH ZEROS.
C SENDS BACK IN V ARRAY. 
C E.G. 'GET FOO 4.55'  SENDS BACK V1=0, V2=0, V3=4.55, V4=0, ETC.
	DIMENSION I(1),V(1)
	EQUIVALENCE (N,RN)
	DO 62 J=1,22
C ZERO V ARRAY.  (COULD BE 30 ABOVE.)
62	V(J)=0
	DO 6  LEND=72,1,-1
6	IF(I(LEND).NE.' ')GO TO 7
C LEND=END OF CHARS.
	RETURN 
7	M=1
	J=1
8	N=I(J)
	CALL LO2UP(N)
	IF(N.EQ.' ')GO TO 16
	IF(N.NE.'-'.AND.
	1 N.NE.'.'.AND.(N.LT.'0'.OR.N.GT.'9'))GO TO 10
C NOW IT'S A NUMBER
20	CALL NUMZ(KK,I(J),V(M))
	J=J+KK-1
10	M=M+1
16	J=J+1
	IF(J.LE.LEND)GO TO 8 
	END
 
	SUBROUTINE NUMZ(KK,I,X)
	DIMENSION I(1)
	DATA IZERO/'0'/
	J=-1
	M=0
	XMINUS=1.
	DO 21 KK=1,15
C IS 15 ENOUGH?  YES, WILL DO ONLY 8 DIGITS PLUS DECI.PT.
	IX=I(KK)
	IF(IX.EQ.' ')GO TO 20
	IF(IX.EQ.'-')GO TO 24
	IF(IX.NE.'.')GO TO 22
	J=KK
	GO TO 21
24	XMINUS=-XMINUS
	GO TO 21
22	N=(IX-IZERO)/536870912
	M=N+M*10
21	CONTINUE
20	IF(J.LT.0)GO TO 23
	X=KK-J-1
	X=XMINUS*M/(10.**X)
	RETURN
23	X=XMINUS*M
C FOR NO DECI.
	END
 
	SUBROUTINE UNPACK(M,N,L,I)
C  L IS FOR VIS. OR INVIS. LINES.
	N=I
	L=0
	IF(N.LT.100000000)GO TO 2
	L=(N/100000000)*100000000
	N=N-L
2	M=N/10000
	N=N-M*10000
	IF(M.GT.1000)M=1000-M
	IF(N.GT.1000)N=1000-N
	END

	SUBROUTINE REPACK(M,N,L,I)
	M=M*10000
	IF(M.LT.0)M=10000000-M
	IF(N.LT.0)N=1000-N
	M=M+L
	I=M+N
	END